home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / libraries / string-ext / finite-automaton.dylan < prev    next >
Encoding:
Text File  |  1995-03-15  |  15.7 KB  |  479 lines  |  [TEXT/ttxt]
  1. module:   regular-expressions
  2. author:   Nick Kramer (nkramer@cs.cmu.edu)
  3. synopsis: Everything that relates to finite automaton
  4.           (build-NFA, NFA-to-DFA, sim-DFA)
  5. copyright:  Copyright (C) 1994, Carnegie Mellon University.
  6.             All rights reserved.
  7. rcs-header: $Header: finite-automaton.dylan,v 1.1 94/11/08 22:56:21 nkramer Exp $
  8.  
  9. //======================================================================
  10. //
  11. // Copyright (c) 1994  Carnegie Mellon University
  12. // All rights reserved.
  13. // 
  14. // Use and copying of this software and preparation of derivative
  15. // works based on this software are permitted, including commercial
  16. // use, provided that the following conditions are observed:
  17. // 
  18. // 1. This copyright notice must be retained in full on any copies
  19. //    and on appropriate parts of any derivative works.
  20. // 2. Documentation (paper or online) accompanying any system that
  21. //    incorporates this software, or any part of it, must acknowledge
  22. //    the contribution of the Gwydion Project at Carnegie Mellon
  23. //    University.
  24. // 
  25. // This software is made available "as is".  Neither the authors nor
  26. // Carnegie Mellon University make any warranty about the software,
  27. // its performance, or its conformity to any specification.
  28. // 
  29. // Bug reports, questions, comments, and suggestions should be sent by
  30. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  31. //
  32. //======================================================================
  33.  
  34.  
  35. /* ----------------------------------------------------------------- */
  36. // build-NFA:
  37. // Takes a reg-exp parse tree and builds an NFA (nondeterministic
  38. // finite automaton)
  39. /* ----------------------------------------------------------------- */
  40.  
  41. // The machine is a graph of <NFA-state>s.  The class hierarchy has
  42. // some correspondence to parsing, but not all that much.  There are
  43. // several subclasses of <NFA-state>.  There's the <e-state>, which
  44. // consumes no input and has two next states.  There's <atom>, which
  45. // consumes exactly one input.  <atom> has several subclasses, and
  46. // contains every legal parse atom that's not a backreference.
  47. // And there's <assertion>, which consume no input.
  48.  
  49. // Quantifiers are expanded into perfectly normal finite automata.  *,
  50. // +, and ? are special cased; everything else is brutally stupid.
  51. // "a{5}" becomes "aaaaa", and "a{2,4}" becomes "(aa)|(aaa)|(aaaa)"
  52.  
  53. // The regular expression must be a string that consists only of
  54. // byte-characters.  (That's not the same thing as saying input has to
  55. // be a byte-string) build-NFA doesn't really care, but NFA-to-DFA and
  56. // sim-DFA do.
  57.  
  58. define constant <NFA-state?> = union(<NFA-state>, singleton(#f));
  59.  
  60. define class <NFA-state> (<object>)
  61.   slot next-state :: <NFA-state?>,
  62.     init-value: #f, init-keyword: next-state: ;
  63. //  slot number;         // Debugging purposes only
  64. end class <NFA-state>;
  65.  
  66.  
  67. define class <e-state> (<NFA-state>)
  68.   slot other-next-state :: <NFA-state?>, 
  69.     init-value: #f, init-keyword: other-next-state: ;
  70. end class <e-state>;
  71.  
  72.  
  73. define class <atom> (<NFA-state>)
  74. end class <atom>;
  75.  
  76.  
  77. define class <character-atom> (<atom>)
  78.   slot atom-char :: <character>, required-init-keyword: character: ;
  79. end class <character-atom>;
  80.  
  81.  
  82. define class <set-atom> (<atom>)
  83.   slot atom-set :: <character-set>, required-init-keyword: set: ;
  84. end class <set-atom>;
  85.  
  86.  
  87. define class <assertion> (<NFA-state>)
  88.   slot asserts :: <symbol>, required-init-keyword: assertion: ;
  89. end class <assertion>;
  90.  
  91.  
  92. // All debugging code
  93. /*
  94. define variable machine = make(<stretchy-vector>);
  95. define variable state-count = 0;
  96.  
  97. define method initialize(s :: <NFA-state>, #next next-method,
  98.              #all-keys);
  99.   s.number := state-count;
  100.   machine[s.number] := s;
  101.   state-count := state-count + 1;
  102.   next-method();
  103. end method initialize;
  104. */
  105.  
  106. define method build-nfa (r :: <union>) 
  107.     => (first-state :: <NFA-state>, last-state :: <NFA-state>);
  108.   let (n1-front, n1-back) = build-nfa(r.left);
  109.   let (n2-front, n2-back) = build-nfa(r.right);
  110.   let first = make(<e-state>, 
  111.            next-state: n1-front, other-next-state: n2-front);
  112.   let last = make(<e-state>);
  113.   n1-back.next-state := last;
  114.   n2-back.next-state := last;
  115.   values(first, last);
  116. end method build-nfa;
  117.  
  118.  
  119.   // Concatenation
  120. define method build-nfa (r :: <alternative>) 
  121.     => (first-state :: <NFA-state>, last-state :: <NFA-state>);
  122.   let (n1-front, n1-back) = build-nfa(r.left);
  123.   let (n2-front, n2-back) = build-nfa(r.right);
  124.   n1-back.next-state := n2-front;
  125.   values(n1-front, n2-back);
  126. end method build-nfa;
  127.  
  128.  
  129. define method build-nfa (r :: <parsed-assertion>) 
  130.     => (first-state :: <NFA-state>, last-state :: <NFA-state>);
  131.   let node = make(<assertion>, assertion: r.asserts);
  132.   values(node, node);
  133. end method build-nfa;
  134.  
  135.  
  136. define method build-nfa (r :: <quantified-atom>) 
  137.     => (first-state :: <NFA-state>, last-state :: <NFA-state>);
  138.   build-quantified-nfa(r.atom, r.min-matches, r.max-matches);
  139. end method build-nfa;
  140.  
  141.  
  142. define method build-nfa (r :: <mark>)
  143.   build-nfa(r.child);
  144. end method build-nfa;
  145.  
  146.  
  147. // This method should never be called, because true finite automaton
  148. // can't handle backreferences.
  149. //
  150. define method build-nfa (r :: <parsed-backreference>) 
  151.     => (first-state :: <NFA-state>, last-state :: <NFA-state>);
  152.   error("Damn it, Jim, I'm a finite automaton, not a Turing machine!");
  153. end method build-nfa;
  154.  
  155.  
  156. define method build-nfa (r :: <parsed-character>) 
  157.     => (first-state :: <NFA-state>, last-state :: <NFA-state>);
  158.   let node = make(<character-atom>, character: r.character);
  159.   values(node, node);
  160. end method build-nfa;               
  161.                        
  162.  
  163. define method build-nfa (r :: <parsed-set>) 
  164.     => (first-state :: <NFA-state>, last-state :: <NFA-state>);
  165.   let node = make(<set-atom>, set: r.char-set);
  166.   values(node, node);
  167. end method build-nfa;               
  168.                    
  169.  
  170. // Handle the quantified parse element
  171. //
  172. define method build-quantified-nfa (r :: <parsed-regexp>, min :: <integer>, 
  173.                     max :: <integer?>)
  174.     =>  (first-state :: <NFA-state>, last-state :: <NFA-state>);
  175.   if (min = 0 & max = 1)       // ?
  176.     let (n-front, n-back) = build-nfa(r);
  177.     let e-back = make(<e-state>);
  178.     let e-front = make(<e-state>, next-state: e-back, 
  179.                other-next-state: n-front);
  180.     n-back.next-state := e-back;
  181.     values(e-front, e-back);
  182.  
  183.   elseif (min = 0 & ~max)      // *
  184.     let (n-front, n-back) = build-nfa(r);
  185.     let first-last = make(<e-state>, other-next-state: n-front);
  186.     n-back.next-state := first-last;
  187.     values(first-last, first-last);
  188.     
  189.   elseif (min = 1 & ~max)      // +
  190.     let (n-front, n-back) = build-nfa(r);
  191.     let last = make(<e-state>, other-next-state: n-front);
  192.     n-back.next-state := last;
  193.     values(n-front, last);
  194.  
  195.   elseif (min = 0 & max = 0)    // {0}, which is a special case of {n} below
  196.     let e = make(<e-state>);
  197.     values(e, e);
  198.  
  199.   elseif (min = max)           // {n} where n is non-zero
  200.     let (first-state, last-state) = build-nfa(r);
  201.     for (i from 2 to min)
  202.       let (another-begin, another-end) = build-nfa(r); 
  203.       last-state.next-state := another-begin;
  204.       last-state := another-end;
  205.     end for;
  206.     values(first-state, last-state);
  207.       
  208.   elseif (~max)                // {n,} where n is non-zero
  209.     let (first, last) = build-quantified-nfa(r, min - 1, min - 1);
  210.     let (another-begin, another-end) = build-nfa(r);
  211.     last.next-state := another-begin;
  212.     let e = make(<e-state>, other-next-state: another-begin);
  213.     another-end.next-state := e;
  214.     values(first, e);
  215.  
  216.   else                         // {n,m} with n < m
  217.     let e-back = make(<e-state>);
  218.     let (front1, back1) = build-quantified-nfa(r, max, max);
  219.     let (front2, back2) = build-quantified-nfa(r, min, max - 1);
  220.     back1.next-state := e-back;
  221.     back2.next-state := e-back;
  222.     let e-front = make(<e-state>, next-state: front1, 
  223.                other-next-state: front2);
  224.     values(e-front, e-back);
  225.   end if;
  226. end method build-quantified-nfa;
  227.  
  228.  
  229. /* ----------------------------------------------------------------- */
  230. // NFA-to-DFA:
  231. // Converts a non-deterministic finite automata (NFA) to a
  232. // deterministic finite automata (DFA).
  233. /* ----------------------------------------------------------------- */
  234.  
  235. define class <DFA-state> (<object>)
  236.   slot final-state? :: <boolean>, init-keyword: final-state:,  init-value: #f;
  237. end class <DFA-state>;
  238.  
  239.  
  240. define class <DFA-character> (<DFA-state>)
  241.   slot next-state :: <byte-character-table>, 
  242.     init-function: method () make(<byte-character-table>) end;
  243. end class <DFA-character>;
  244.  
  245.  
  246. define class <DFA-assertion> (<DFA-state>)
  247.   slot asserts :: <symbol>;
  248.   slot true-state :: <DFA-state>;
  249.   slot false-state :: <DFA-state>;
  250. end class <DFA-assertion>;
  251.  
  252.  
  253. // Define a <DFA-state-table> that's a subclass of <object-table>.
  254. // The key is a set of NFA states, and the value is a DFA state.  (I
  255. // needed a new type of table to operate like a set)
  256. //
  257. define class <dfa-state-table> (<object-table>)
  258. end class <dfa-state-table>;
  259.  
  260.  
  261. define method my-test-function (set1 :: <list>, set2 :: <list>);
  262.   size(union(set1, set2, test: \==)) = size(set1);
  263. end method my-test-function;
  264.  
  265.  
  266. define method my-hash-function (set :: <list>)
  267.   let id = 0;
  268.   let state = $permanent-hash-state;
  269.   for (elt in set)
  270.     let (elt-id, elt-state) = object-hash(elt);
  271.     let (new-id, new-state) = merge-hash-codes(id, state, elt-id, elt-state,
  272.                            ordered: #f);
  273.     id := new-id;
  274.     state := new-state;
  275.   end for;
  276.   values(id, state);
  277. end method my-hash-function;
  278.  
  279.  
  280. define method table-protocol (table :: <dfa-state-table>)
  281.   values(my-test-function, my-hash-function);
  282. end method table-protocol;
  283.  
  284.  
  285. // e-closure takes a sequence of NFA states and returns another
  286. // sequence of all the NFA states that can be reached from the first
  287. // set using only e-transitions.
  288. //
  289. define method e-closure (nfa-states :: <sequence>) 
  290.     => more-nfa-states :: <sequence>;
  291.   let stack = as(<deque>, nfa-states);
  292.   let reachable-states = #();
  293.   until (empty?(stack))
  294.     let state = pop(stack);        // state is an NFA state (or #f)
  295.     if (instance?(state, <e-state>))
  296.       push(stack, state.next-state);
  297.       push(stack, state.other-next-state);
  298.     elseif (state = #f)
  299.       #f;    // do nothing
  300.     else
  301.       reachable-states := add-new!(reachable-states, state, test: \==);
  302.     end if;
  303.   end until;
  304.   reachable-states;
  305. end method e-closure;
  306.  
  307.  
  308. // Does this collection of NFA states contain an assertion?  If so,
  309. // it'll have to be split into two collections of states, one for if
  310. // the assertion turned out to be true, and one if the assertion turns
  311. // out to be false.  (Assertions can only be tested at runtime)
  312. //
  313. define method has-assertions? (nfa-states :: <sequence>)
  314.   local method test-elt (ignored, elt :: <object>)
  315.       instance?(elt, <assertion>)
  316.     end method test-elt;
  317.   member?(#f, nfa-states, test: test-elt);
  318. end method has-assertions?;
  319.  
  320.  
  321. // Takes a set of NFA states, and either finds an already made DFA
  322. // equivalent state, or makes a new DFA state if no such state already
  323. // exists.
  324. //
  325. define method get-dfa-state-equiv (nfa-states :: <sequence>,
  326.                    table :: <dfa-state-table>,
  327.                    nfa-end-state :: <nfa-state>,
  328.                    superstates-to-process :: <deque>)
  329.     => dfa-state :: <DFA-state>;
  330.   let result = element(table, nfa-states, default: #f);
  331.   if (result)                              
  332.     result;
  333.   elseif (has-assertions?(nfa-states))     
  334.     let new-dfa-state = 
  335.       make(<DFA-assertion>,
  336.        final-state: member?(nfa-end-state, nfa-states, test: \==));
  337.     table[nfa-states] := new-dfa-state;
  338.     push(superstates-to-process, nfa-states);
  339.     new-dfa-state;
  340.   else
  341.     let new-dfa-state = 
  342.       make(<DFA-character>, 
  343.        final-state: member?(nfa-end-state, nfa-states, test: \==));
  344.     table[nfa-states] := new-dfa-state;
  345.     push(superstates-to-process, nfa-states);
  346.     new-dfa-state;
  347.   end if;
  348. end method get-dfa-state-equiv;
  349.  
  350.  
  351. // This finds an assertion and removes it.  The return values are the
  352. // assertion found, and T minus the assertion.  (#f is returned for
  353. // assertion if no assertion is found)
  354. //
  355. define method remove-an-assertion (T :: <sequence>)
  356.  => (found :: union(singleton(#f), <assertion>), new-T :: <sequence>);
  357.   let found = #f;
  358.   let new-list = #();
  359.   for (elt in T)
  360.     if (~found & instance?(elt, <assertion>))
  361.       found := elt;
  362.     else
  363.       new-list := add!(new-list, elt);
  364.     end if;
  365.   end for;
  366.   values(found, new-list);
  367. end method remove-an-assertion;
  368.  
  369.  
  370. // This follows the method described on p. 118 of Compilers by Aho,
  371. // Sethi, and Ullman (the dragon book), with hacks to handle
  372. // assertions.
  373. //
  374. define method nfa-to-dfa(nfa-begin :: <NFA-state>, nfa-end :: <NFA-state>,
  375.              equal? :: <function>) 
  376.     => dfa :: <DFA-state>;
  377.   let final-state = make(<assertion>, assertion: #"final-state");
  378.   nfa-end.next-state := final-state;
  379.            // Make a special final state we know we can identify
  380.  
  381.   let superstates-to-process = make(<deque>);
  382.   let dfa-table = make(<dfa-state-table>);
  383.   let dfa-version = rcurry(get-dfa-state-equiv, dfa-table, final-state,
  384.                superstates-to-process);
  385.   let init-dfa-state = dfa-version(e-closure(list(nfa-begin)));
  386.   
  387.   until (empty?(superstates-to-process))
  388.     let T = pop(superstates-to-process);
  389.     let dfa-T = dfa-version(T);
  390.  
  391.     if (instance?(dfa-T, <DFA-character>))
  392.        // One of the nice things about a character jump table is it gives
  393.        // a convenient way to step through all possible characters c.
  394.       for (dummy-val keyed-by c in dfa-T.next-state)
  395.     let next-superstate = #();
  396.     for (nfa-state in T)
  397.       if (atom-accepts?(nfa-state, c, equal?))
  398.         next-superstate := add!(next-superstate, nfa-state.next-state);
  399.       end if;
  400.     end for;
  401.     dfa-T.next-state [c] := dfa-version(e-closure(next-superstate));
  402.       end for;
  403.  
  404.     else  // must be a <DFA-assertion>.  Add a runtime check for the assertion.
  405.       let (assertion, T-false) = remove-an-assertion(T);
  406.       let T-true = if (assertion.next-state ~= #f)
  407.              add(T-false, assertion.next-state);
  408.            else
  409.              T-false;
  410.            end if;
  411.       dfa-T.false-state := dfa-version(T-false);
  412.       dfa-T.true-state := dfa-version(e-closure(T-true));
  413.       dfa-T.asserts := assertion.asserts;
  414.     end if;
  415.   end until;
  416.  
  417.     // return value
  418.   init-dfa-state;
  419. end method nfa-to-dfa;
  420.  
  421.  
  422. // Says whether a character is accepted or not, given the
  423. // atom to accept it.
  424. //
  425. define method atom-accepts? (atom :: <character-atom>, c :: <character>,
  426.                  equal? :: <function>) => answer :: <boolean>;
  427.   equal?(c, atom.atom-char);
  428. end method atom-accepts?;
  429.  
  430.  
  431. define method atom-accepts? (atom :: <set-atom>, c :: <character>,
  432.                  equal? :: <function>) => answer :: <boolean>;
  433.   member?(c, atom.atom-set);
  434. end method atom-accepts?;
  435.  
  436.  
  437. /* ----------------------------------------------------------------- */
  438. // Sim-DFA:
  439. // Simulates a deterministic finite automaton (DFA)
  440. /* ----------------------------------------------------------------- */
  441.  
  442. // If it ever touches a state marked as a final state, it answers #t.
  443. // Input must be a string that consists only of byte-characters.
  444. // (That's not the same thing as saying input has to be a byte-string)
  445. //
  446. define method sim-dfa (dfa-start :: <DFA-state>, input :: <string>, 
  447.                start :: <integer>)
  448.   let dfa-state = dfa-start;
  449.  
  450.   block (return)
  451.     for (index from start below size(input))
  452.       let char = input[index];
  453.       if (dfa-state.final-state?)  return(#t) end if;
  454.       while (instance?(dfa-state, <DFA-assertion>))
  455.     dfa-state := 
  456.       if (assertion-true?(dfa-state.asserts, input, index))
  457.         dfa-state.true-state;
  458.       else
  459.         dfa-state.false-state;
  460.       end if;
  461.     if (dfa-state.final-state?)      return(#t);       end if;
  462.       end while;
  463.       // dfa-state must be a <DFA-character> now.
  464.  
  465.       dfa-state := dfa-state.next-state [char];
  466.     end for;
  467.     while (instance?(dfa-state, <DFA-assertion>))
  468.       if (dfa-state.final-state?)      return(#t);       end if;
  469.       dfa-state := 
  470.     if (assertion-true?(dfa-state.asserts, input, size(input)))
  471.       dfa-state.true-state;
  472.     else
  473.       dfa-state.false-state;
  474.     end if;
  475.     end while;
  476.     dfa-state.final-state?;            // return value
  477.   end block;
  478. end method sim-dfa;
  479.